home *** CD-ROM | disk | FTP | other *** search
/ Business Assistant / Business Assistant.iso / acctg / bf018 / expense.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1987-11-26  |  17.7 KB  |  238 lines
  1. 10  CLEAR,,1536:CLS:FOR N=1 TO 10:KEY N, "":NEXT:KEY 8, "@":ON KEY(7) GOSUB 9000:PRINT:PRINT:ON ERROR GOTO 10000
  2. 40  OPEN "B:EXPENSE.CUR" AS #1:DIM N(30), YTD(30)
  3. 50  PRINT "            EXPENSE PROGRAM----PRESS KEY TO CHOOSE OPTION":PRINT:PRINT TAB(10) "O=OPEN NEW FILE":PRINT:PRINT TAB(10) "A=ADD TO FILE":PRINT
  4. 80  PRINT TAB(10) "R=READ REVISE OR PRINT FILE OR ADD NON-CHECK EXPENSE":PRINT:PRINT TAB(10) "P=PAYROLL":PRINT:PRINT TAB(10) "E=END MONTH--TURN ON PRINTER":PRINT
  5. 100  PRINT TAB(10) "M=RETURN TO MENU":PRINT: PRINT TAB(10) "F=PAYEE FILE":PRINT:PRINT TAB(10)"C=CATEGORY OF EXPENSE FILE":PRINT:PRINT TAB(10) "I=READ OR PRINT OLD EXPENSE FILE":DL$="$$######.##"
  6. 120  MODE$=CHR$(27)+CHR$(45)+CHR$(1)+CHR$(27)+CHR$(71)+CHR$(27)+CHR$(78)+CHR$(6):DEFDBL A-Z:DEFINT N,I,J:XMOD$=CHR$(27)+CHR$(45)+CHR$(0)+CHR$(27)+CHR$(72)
  7. 160  X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="A" OR X$="P" THEN FL$="EXPENSE.CUR":GOSUB 30210 ELSE IF X$="E" THEN FL$="EXPENSE.TOT":GOSUB 30210:FL$="CHECKING.ACC":GOSUB 30210:FL$="CHKDSC":GOSUB 30210
  8. 170  IF X$="A"THEN GOSUB 400 ELSE IF X$="R"THEN 1690 ELSE IF X$="P"THEN RUN "PAYROLL.BAS"ELSE IF X$="O"THEN 1120 ELSE IF X$="M"THEN RUN"BKPG.BAS"ELSE IF X$="E"THEN 2590 ELSE IF X$="F"THEN 6000 ELSE IF X$="C"THEN 7000 ELSE IF X$="I"THEN 4000 ELSE 160
  9. 180  IF LOF(1)/128<8 THEN 190 ELSE 210
  10. 190  BEEP: COLOR 31: PRINT "FILE NOT OPENED FOR MONTH": COLOR 7:PRINT:PRINT:GOTO 50
  11. 210  CLS:OPEN "PAYEE.FIL" AS 2
  12. 220  FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$
  13. 230  PRINT TAB(10) "TO USE TODAY'S DATE        PRESS ENTER
  14. 240  PRINT TAB(10) "TO SET DIFFERENT DATE      ENTER DATE":PRINT TAB(10) "IF FINISHED                ENTER  F":PRINT "                                    ";:INLN%=8:GOSUB 20050:ND$=INPT$:IF ND$="F" OR ND$="f" THEN CLS:GOTO 10
  15. 280  IF ND$="" THEN IF LEFT$(DATE$,1)>"0" THEN ND$=LEFT$(DATE$,6)+RIGHT$(DATE$,2) ELSE ND$=MID$(DATE$,2,5)+RIGHT$(DATE$,2)
  16. 290  GET 1, LOF(1)/128:PRINT TAB(40)"C=CHECK EXPENSE":PRINT TAB(40) "N=NON-CHECK EXPENSE"
  17. 296  X$=INKEY$:IF X$="C" OR X$="c" THEN 300 ELSE IF X$="N" OR X$="n" THEN CHECK%=0:GOTO 311 ELSE 296
  18. 300  CODE%=LOF(1)/128:IF CODE%=9 THEN GET 1,1:CHECK%=CVI(F$):GOTO 320
  19. 310  IF CODE%>9 THEN CHECK%=CVI(C$)+1:GOTO 320
  20. 311  FOR N=2 TO 9:GET 1,N:IF LEFT$(D$,2)="  " THEN CODE%=N:GOTO 330
  21. 314  NEXT:PRINT "NO MORE RECORD SPACE AVAILABLE FOR NON-CHECK EXPENSES, HOLD UNTIL NEXT MONTH OR USE REVISE TO COMBINE WITH ANOTHER NON-CHECK EXPENSE.  PRESS  F8  TO RETURN TO  OPTIONS."
  22. 316  X$=INKEY$:IF X$="@" THEN 10 ELSE 316
  23. 320  CODE%=CODE%+1:ADR$=""
  24. 330  PRINT:PRINT TAB(42) "PAY TO  ";:INLN%=25:GOSUB 20050:PAY$=INPT$:IF LEN(PAY$)<4 THEN 1450
  25. 350  PRINT "    AMOUNT PAID (USE DECIMAL POINT e.g. 000.00)  ";:NBR=1:INLN%=9:GOSUB 20050:AM=VAL(INPT$):NBR=0
  26. 360  IF X$="N" OR X$="n" THEN PRINT "                                            FOR  "; ELSE PRINT "FOR (IF MORE THEN ONE TYPE OF EXPENSE ENTER *)?  ";
  27. 361  INLN%=18:GOSUB 20050:EP$=INPT$:PRINT:IF EP$="*" THEN GOTO 490
  28. 380  GOSUB 900:GOTO 1020
  29. 400  CLS
  30. 410  GET 1, 1:FIELD 1, 10 AS M$, 5 AS Y$, 34 AS S$, 6 AS F$:FOR I=2 TO LOF(1)/128:CODE%=I:GET 1, CODE%:FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$:NEXT:RETURN
  31. 490  ZM=AM:FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$:CD%=CODE%:AM=0:FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$:FOR I=1 TO 3:CODE%=CODE%+1
  32. 620  IF I=1 THEN PRINT "AMOUNT OF 1ST TYPE  ";ELSE IF I=2 THEN PRINT "AMOUNT OF 2ND TYPE  ";ELSE PRINT "AMOUNT OF 3RD TYPE (ENTER 0 IF DONE)  ";
  33. 622  NBR=1:INLN%=9:GOSUB 20050:AM(I)=VAL(INPT$):NBR=0:IF AM(I)=0 THEN CODE%=CODE%-1:GOTO 730
  34. 640  PRINT TAB(34) "FOR  ";:INLN%=18:GOSUB 20050:EP$(I)=INPT$:ZA=ZA+AM(I):NEXT I
  35. 730  IF ABS(ZM-ZA)<0.005 THEN 765
  36. 740  BEEP: BEEP: COLOR 0,7: PRINT "TOTAL OF AMOUNTS DOES NOT EQUAL CHECK AMOUNT-REDO": COLOR 7,0:CODE%=CD%:AM=0:ZA=0:ZM=0:FOR I=1 TO 3:AM(I)=0:EP$(I)="":NEXT:GOTO 330
  37. 760  FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$
  38. 765  PRINT:PRINT TAB(10) "P=PRINT CHECK AND ENTER DATA":PRINT:PRINT TAB(10) "E=ENTER DATA ONLY":PRINT
  39. 767  PE$=INKEY$:IF PE$=CHR$(27) THEN 10 ELSE IF PE$<>"P" AND PE$<>"E" THEN 767
  40. 770  LSET D$=ND$:LSET C$=MKI$(CHECK%):LSET B$=PAY$:LSET A$=MKD$(ZM):LSET E$="*":PUT 1,CD%:FOR I=1 TO CODE%-CD%:LSET D$="":LSET C$=MKI$(CHECK%):LSET B$="":LSET A$=MKD$(AM(I)):LSET E$=EP$(I):PUT 1,CD%+I:NEXT:IF PE$="P" THEN AM=ZM:GOSUB 5000
  41. 878  ZA=0:GOTO 220
  42. 880  PRINT "    AMOUNT PAID (USE DECIMAL POINT e.g. 000.00)  ";:NBR=1:INLN%=9:GOSUB 20050:AM=VAL(INPT$):NBR=0:GOSUB 900: GOTO 1020
  43. 900  LSET D$=ND$:LSET C$=MKI$(CHECK%):LSET B$=PAY$:LSET A$=MKD$(AM):LSET E$=EP$:IF SKIP=1 THEN 1010
  44. 960  PRINT D$;:PRINT USING "#######"; CVI(C$);:PRINT "   "+B$;:PRINT USING "$$#####.##"; CVD(A$);:PRINT "   "+E$
  45. 1010  SKIP=0: RETURN
  46. 1020  PRINT:IF X$="C" OR X$="c" THEN PRINT TAB(10) "PRESS  P      TO PRINT CHECK AND ENTER DATA"
  47. 1030  PRINT TAB(10) "PRESS  C      TO CHANGE ENTRY":PRINT TAB(10) "PRESS  E      TO ENTER DATA"
  48. 1050  X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="P" THEN GOSUB 5000:GOTO 1090 ELSE IF X$="C" THEN 230 ELSE IF X$="E" THEN 1090 ELSE IF X$=CHR$(27) THEN 50 ELSE 1050
  49. 1070  PRINT "DATE  ";:INLN%=8:GOSUB 20050:ND$=INPT$:GOTO 330
  50. 1090  PUT #1, CODE%:ADR$="": CITY$="":GOTO 220
  51. 1120  CLS: GOSUB 410:IF CVI(F$)>0 THEN 1140 ELSE 1160
  52. 1140  BEEP:COLOR 31: PRINT "FILE ALREADY OPENED THIS MONTH OR LAST MONTHS FILE NOT CLOSED OUT": COLOR 7:GOTO 50
  53. 1160  PRINT "                MONTH  ";:GOSUB 20050:MON$=INPT$:PRINT "                 YEAR  ";:NBR=1:INLN%=5:GOSUB 20050:YR=VAL(INPT$):PRINT "NUMBER OF FIRST CHECK  ";:INLN%=6:GOSUB 20050:FCHECK%=VAL(INPT$):NBR=0:CODE%=1
  54. 1200  FIELD 1, 10 AS M$, 5 AS Y$, 34 AS S$, 6 AS F$:LSET M$=MON$:LSET Y$=MKI$(YR):LSET S$="    EXPENSE FILE     FIRST CHECK #":LSET F$=MKI$(FCHECK%):PUT 1, 1:FOR CODE%=1 TO 9:ND$="":CHECK%=0:PAY$="":AM=0:EP$="":LSET D$=ND$:LSET C$=MKI$(CHECK%)
  55. 1290  LSET B$=PAY$:LSET A$=MKD$(AM):LSET E$=EP$:FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$:PUT 1, CODE%:NEXT:GOTO 50
  56. 1450  FIELD 2, 5 AS F$, 35 AS G$, 35 AS H$, 35 AS I$, 16 AS J$:FOR N=1 TO LOF(2)/128:GET 2,N:IF PAY$=LEFT$(F$,3) THEN PAY$=G$:ADR$=H$:CITY$=I$:EP$=J$:GOTO 880
  57. 1490  NEXT:PRINT " ABBREVIATION NOT FOUND. USE 4 OR MORE LETTERS FOR PAYEE OR CHECK ABBREVIATION":GOTO 330
  58. 1690  CLS:PRINT:PRINT TAB(10) "R=READ ONLY":PRINT:PRINT TAB(10) "P=READ AND PRINT"
  59. 1693  PRT$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF PRT$<>"P" AND PRT$<>"R" THEN 1693 ELSE CLS
  60. 1700  COLOR 0,7: PRINT "       PRESS  F8  TO READ RECORDS IN SEQUENCE. PRESS   F7  TO STOP AT ANY POINT. PRESS   F8  WHEN READY TO CONTINUE READING.":COLOR 7,0: PRINT:PRINT
  61. 1710  COLOR 0,7:PRINT "  IF REVISING FILE, WRITE DOWN RECORD NUMBERS TO BE CHANGED.": PRINT:PRINT
  62. 1720  X$=INKEY$:IF X$<>"@" THEN 1720 ELSE DEF SEG:POKE 106,0:KEY(7) ON:COLOR 7,0
  63. 1740  PRINT "DATE      CHECK        PAID TO                 AMOUNT        FOR            REC":PRINT:IF LOF(1)/128=0 THEN PRINT "     NO RECORDS IN FILE---PRESS F8 TO RETURN TO OPTIONS" ELSE 1750
  64. 1746  X$=INKEY$:IF X$<>"@" THEN 1746 ELSE CLS:GOTO 50
  65. 1750  GET 1, 1:FIELD 1, 10 AS M$,5 AS Y$, 34 AS S$, 6 AS F$:T=0:FOR I=2 TO LOF(1)/128:CODE%=I:GET 1, CODE%:FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$:EP=ASC(E$):IF EP=42 THEN 1900
  66. 1880  IF EP=32 AND D$="        " AND CVD(A$)<0.01 THEN 1980
  67. 1890  T=T+CVD(A$)
  68. 1900  PRINT D$;:PRINT USING "#######";CVI(C$);:PRINT "   "+B$;:IF EP=42 THEN PRINT USING"**######.##";CVD(A$); ELSE PRINT USING " $$#####.##";CVD(A$);
  69. 1940  IF EP=42 THEN PRINT E$+"   "; ELSE PRINT "   "+E$;
  70. 1950  PRINT CODE%:IF CODE% MOD 20=0 THEN 1970 ELSE 1980
  71. 1970  PRINT:PRINT "DATE      CHECK        PAID TO                 AMOUNT        FOR            REC":PRINT
  72. 1980  NEXT:PRINT: PRINT:PRINT "TOTAL PAID OUT THROUGH CHECK NO. ";CVI(C$);"   ";D$;"   IS";:PRINT USING DL$;T:PRINT:PRINT:PRINT:IF PRT$="P" THEN 2590
  73. 2027  IF OLD% THEN KEY(7) OFF:PRINT:PRINT "    PRESS   F8  TO  RETURN TO OPTIONS":GOTO 2028 ELSE 2030
  74. 2028  X$=INKEY$:IF X$<>"@" THEN 2028 ELSE CLS:GOTO 10
  75. 2030  PRINT TAB(10) "R=REVISE":PRINT:PRINT TAB(10) "O=RETURN TO OPTIONS":PRINT:PRINT TAB(10) "M=RETURN TO MENU":KEY(7) OFF
  76. 2040  X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="R" THEN FL$="EXPENSE.CUR":GOSUB 30210:GOTO 2340 ELSE IF X$="O" THEN CLS:GOTO 10 ELSE IF X$="M" THEN RUN "BKPG.BAS" ELSE 2040
  77. 2060  FOR N=1 TO LOF(3)/128:GET 3, N:INS(1)=INSTR(L$,CHR$(44)):INS(2)=INSTR(INS(1)+2,L$,CHR$(44)):INS(3)=INSTR(INS(2)+2,L$,CHR$(44))
  78. 2110  IF LEFT$(EP$,3)=LEFT$(L$,3) OR LEFT$(EP$,3)=MID$(L$,INS(1)+2,3) OR LEFT$(EP$,3)=MID$(L$,INS(2)+2,3) OR LEFT$(EP$,3)=MID$(L$,INS(3)+2,3) THEN RETURN
  79. 2120  NEXT:LST=N:RETURN
  80. 2340  CLS
  81. 2350  PRINT:PRINT "RECORD NUMBER  ";:NBR=1:INLN%=6:GOSUB 20050:CODE%=VAL(INPT$):GET 1, CODE%:COLOR 0,7:FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$:GOSUB 960:PRINT TAB(76) CODE%: COLOR 7,0:PRINT "DATE ";:INLN%=8:GOSUB 20050:ND$=INPT$
  82. 2410  PRINT "CHECK NUMBER (ENTER 0 IF NON-CHECK EXPENSE) ";:INLN%=8:NBR=1:GOSUB 20050:CHECK%=VAL(INPT$):PRINT "AMOUNT ";:INLN%=9:GOSUB 20050:AM=VAL(INPT$):NBR=0:IF AM=0 THEN EP$="VOID":PAY$="": GOTO 2480
  83. 2440  PRINT "PAY TO (NO ABBREVIATIONS) ";:INLN%=25:GOSUB 20050:PAY$=INPT$:PRINT "FOR ";:INLN%=18:GOSUB 20050:EP$=INPT$:PRINT:PRINT:PRINT:PRINT
  84. 2480  GOSUB 900:PRINT TAB(10) "C=DATA IS CORRECT":PRINT:PRINT TAB(10) "N=DATA IS NOT CORRECT"
  85. 2500  X$=INKEY$:IF X$="C" THEN 2510 ELSE IF X$="N" THEN 2340 ELSE DEF SEG=64:POKE 23, (PEEK(23) OR 64):GOTO 2500
  86. 2510  PUT 1, CODE%:PRINT:PRINT "        A=REVISE ANOTHER" TAB(89) "R=READ FILE" TAB(89) "O=RETURN TO OPTIONS" TAB(89) "M=RETURN TO MENU"
  87. 2570  X$=INKEY$:IF X$="A" THEN 2350 ELSE IF X$="R" THEN GOTO 1690 ELSE IF X$="M" THEN RUN"BKPG.BAS" ELSE IF X$="O" THEN CLS:GOTO 10 ELSE GOTO 2570
  88. 2590  DIM TE(30), YTD(30):DIM MIS$(30):FIELD 1, 8 AS D$:GET 1, LOF(1)/128:CLS:PRINT:PRINT TAB(10) "DATE OF LAST ENTRY IN FILE IS "+D$:PRINT:PRINT TAB(10) "C=CONTINUE":PRINT:PRINT TAB(10) "O=RETURN TO OPTIONS"
  89. 2605  DEF SEG=64:POKE 23, (PEEK(23) OR 64)
  90. 2606  X$=INKEY$:IF X$="O" THEN 10 ELSE IF X$<>"C" THEN 2606
  91. 2610  EM=1
  92. 2620  CLS:LOCATE 12,23:PRINT "PLEASE WAIT FOR NEXT INSTRUCTIONS.":GET 1,1:FIELD 1, 10 AS M$, 5 AS Y$, 34 AS S$, 6 AS F$:LPRINT CHR$(18):LPRINT MODE$:LPRINT M$;:LPRINT CVI(Y$);:LPRINT S$;:LPRINT CVI(F$):LPRINT:LPRINT
  93. 2710  LPRINT "DATE      CK.NO.     PAID TO                     AMT.    FOR           REC.NO.":LPRINT XMOD$:T=0:OPEN "CATEGORY.FIL" AS 3:FIELD 3, 44 AS L$:FOR I=2 TO LOF(1)/128:CODE%=I:GET 1, CODE%:FIELD 1, 8 AS D$, 8 AS C$, 25 AS B$, 9 AS A$, 18 AS E$
  94. 2770  EP=ASC(E$):IF EP=42 THEN 2850
  95. 2790  IF EP=32 AND D$="        " AND CVD(A$)<0.01 THEN 2910
  96. 2800  T=T+CVD(A$):EP$=E$:GOSUB 2060:IF LEFT$(EP$,3)="VOI" THEN 2840
  97. 2830  IF N=LST THEN GOSUB 3720
  98. 2840  TE(N)=TE(N)+CVD(A$)
  99. 2850  LPRINT D$;:LPRINT USING "#######";CVI(C$);:LPRINT "   "B$;:IF EP=42 THEN LPRINT USING"**######.##";CVD(A$); ELSE LPRINT USING DL$;CVD(A$);
  100. 2890  IF EP=42 THEN LPRINT E$+"   "; ELSE LPRINT "   "+E$;
  101. 2900  LPRINT USING"###";CODE%
  102. 2910  NEXT:IF PRT$="P" THEN LPRINT:LPRINT "TOTAL PAID OUT THROUGH CHECK NO. ";CVI(C$);"   "D$;"  IS";USING DL$;T:LPRINT CHR$(12):GOTO 2027
  103. 2920  LPRINT TAB(45) "___________":LPRINT TAB(10) "    TOTAL PAID OUT THIS MONTH IS ";:LPRINT USING "$$######.##";T:CLS:PRINT "CHECK PRINTED PAGE TO BE SURE IT IS CORRECT. FILE WILL BE REMOVED FROM CURRENT  STATUS WHEN PROGRAM   CONTINUES.":PRINT
  104. 2955  PRINT TAB(10) "P=PRINT AGAIN":PRINT:PRINT TAB(10) "R=REVISE":PRINT:PRINT TAB(10) "C=CONTINUE"
  105. 2960  X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="P" THEN CLEAR,,5120:OPEN "B:EXPENSE.CUR" AS 1 :GOTO 2620 ELSE IF X$="R" THEN GOTO 3500 ELSE IF X$="C" THEN 2980 ELSE 2960
  106. 2980  GET 1,1:LPRINT CHR$(12);:LPRINT MODE$:LPRINT "            EXPENSES                     ";:LPRINT M$;:LPRINT CVI(Y$);:LPRINT "       YTD     REC.NO.":LPRINT XMOD$:IF SKIP=1 THEN 3120
  107. 3040  OPEN "B:EXPENSE.TOT" AS 2
  108. 3050  IF LOF(2)/128>1 THEN 3120
  109. 3060  FIELD 2, 12 AS Q$
  110. 3070  FOR N=1 TO 31:LSET Q$=MKD$(0):PUT 2,N:NEXT
  111. 3120  LPRINT:FOR N=1 TO LOF(3)/128+1:CODE%=N:GET 2, CODE%:FIELD 2, 12 AS Q$:IF N>LOF(3)/128 THEN LPRINT "MISCELLANEOUS                               ";:GOTO 3220
  112. 3180  GET 3, N:IF LEN(L$)<2 THEN 3330 ELSE LPRINT L$;
  113. 3220  LPRINT USING "$$######.##";TE(N);:IF SKIP=1 THEN 3270
  114. 3240  YTD(N)=CVD(Q$)+TE(N):TOT=TOT+TE(N):TY=TY+YTD(N)
  115. 3270  LPRINT USING "$$#########.##";YTD(N);:LPRINT USING "########";CODE%:IF SKIP=1 THEN 3330
  116. 3300  FIELD 2, 12 AS Q$:LSET Q$=MKD$(YTD(N)):PUT 2, CODE%
  117. 3330  NEXT:FIELD 2, 12 AS Z$:LSET Z$=MKD$(TY):PUT 2, 31:IF SKIP=1 THEN SKIP=0:GOTO 3380
  118. 3371  CLOSE 4:BKUP=0:OPEN "B:CHECKING.ACC" AS 4:FIELD 4, 12 AS ZZ$:LSET ZZ$=MKD$(TOT):PUT 4, 2:CLOSE 4
  119. 3380  LPRINT TAB(45) "___________      ____________":LPRINT TAB(23) "TOTAL PAID OUT";:LPRINT TAB(45) USING DL$;TOT;:LPRINT USING "$$#########.##";TY:GOSUB 3760:LPRINT CHR$(12)+CHR$(27)CHR$(64)
  120. 3460  PUT 2, 31:FL$="EXPENSE."+LEFT$(M$,3):GOSUB 30210:CLOSE 1:NAME "B:EXPENSE.CUR" AS "B:"+FL$
  121. 3490  RUN "BKPG.BAS"
  122. 3500  CLS:FOR N=1 TO LST:TE(N)=0:NEXT:PRINT "AFTER REVISING FILE, RETURN TO OPTIONS AND START  END OF MONTH AGAIN. PRESS F8  TO CONTINUE"
  123. 3530  X$=INKEY$:IF X$<>"@" THEN 3530
  124. 3540  GOTO 2340
  125. 3720  J=J+1:MIS$(J)=EP$:MIS(J)=CVD(A$):RETURN
  126. 3760  LPRINT:LPRINT:LPRINT MODE$:LPRINT TAB(20) "SUMMARY OF MISCELLANEOUS EXPENSES":LPRINT:LPRINT XMOD$:FOR J=1 TO 10:IF MIS(1)=0 THEN LPRINT TAB(10) "NONE": GOTO 3830
  127. 3790  IF MIS$(J)="" AND MIS(J)=0 THEN 3830  ELSE 3800
  128. 3800  LPRINT TAB(10) MIS$(J)+"                   ";:LPRINT USING DL$;MIS(J):NEXT
  129. 3830  RETURN
  130. 4000  CLS:OLD%=1:COLOR 0,7:PRINT"      INSERT DISK CONTAINING THE FILE YOU WISH TO READ IN DRIVE  B":COLOR 7,0:PRINT:PRINT:PRINT "ENTER MONTH OF EXPENSE FILE TO BE READ   ";
  131. 4040  INLN%=10:GOSUB 20050:OMON$=INPT$
  132. 4070  FILE$="B:"+"EXPENSE."+LEFT$(OMON$,3):CLOSE 1:OPEN FILE$ AS 1:GOTO 1690
  133. 5000  CLS:LPRINT CHR$(27)CHR$(64):PRINT TAB(10) "N=NO MESSAGE ON CHECK STUB":PRINT:PRINT TAB(10)"I=INVOICE AND CREDIT TYPE MESSAGE":PRINT:PRINT TAB(10)"S=MISCELLANEOUS MESSAGE"
  134. 5007  X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):DEF SEG=64:POKE 23, (PEEK(23) AND 223):IF X$="N" THEN FOR J=1 TO 12:LPRINT:NEXT:GOTO 5021 ELSE IF X$="I" OR X$="S" THEN 5011 ELSE 5007
  135. 5011  CLS:PRINT "TYPE MESSAGE BETWEEN THE LINES IN ANY WAY THAT YOU WOULD LIKE IT PRINTED.":PRINT:PRINT "USE CURSOR KEYS TO MOVE AROUND.":LOCATE 5,1:PRINT STRING$(80,CHR$(22))
  136. 5014  IF X$="I" THEN LOCATE 6,1:PRINT "DATE     INVOICE NUMBER     AMOUNT   ---- DATE     INVOICE NUMBER     AMOUNT    "
  137. 5015  LOCATE 18,1:PRINT STRING$(80,CHR$(22)):LOCATE 19,20:PRINT "PRESS  ENTER   WHEN READY TO CONTINUE":IF X$="I" THEN LOCATE 7,1 ELSE LOCATE 6,1
  138. 5016  LINE INPUT X$:FOR N=6 TO 17:FOR J=1 TO 80:LPRINT CHR$(SCREEN(N,J));:NEXT J:NEXT
  139. 5021  CLS:IF ADR$<>"" THEN 5060 ELSE PRINT:PRINT TAB(13) "IF NO ADDRESS TO BE PRINTED --- JUST PRESS ENTER"
  140. 5023  PRINT:PRINT TAB(15) "TO PRINT ADDRESS OF PAYEE --- ENTER STREET ADDRESS OR BOX NO.":PRINT:PRINT TAB(35);:INLN%=40:GOSUB 20050:ADR$=INPT$:IF ADR$="" THEN CITY$="":GOTO 5060
  141. 5040  PRINT TAB(16) "CITY, STATE  ZIP   ";:INLN%=40:GOSUB 20050:CITY$=INPT$
  142. 5060  FOR N=1 TO 11:LPRINT:NEXT:LPRINT CHR$(27)CHR$(69)+CHR$(27)CHR$(71):LPRINT TAB(53) ND$+" "+CHR$(14);:LPRINT USING "**$###.##";AM:LPRINT:LPRINT:IF ADR$="" THEN LPRINT TAB(7) PAY$:LPRINT:LPRINT:LPRINT CHR$(27)CHR$(64):GOTO 5110
  143. 5100  LPRINT TAB(7) PAY$:LPRINT TAB(7) ADR$:LPRINT TAB(7) CITY$:LPRINT CHR$(27)CHR$(64)
  144. 5110  FOR N=1 TO 10:LPRINT:NEXT:ADR$="":ADD$="":CITY$="":MES$="":RETURN
  145. 6000  CLS:OPEN "A:PAYEE.FIL" AS 2
  146. 6020  FIELD 2, 5 AS F$, 35 AS G$, 35 AS H$, 35 AS I$, 16 AS J$
  147. 6025  IF CAT=1 THEN PRINT TAB(15) "CATEGORY OF EXPENSE FILE":PRINT ELSE PRINT TAB(15) "PAYEE FILE":PRINT
  148. 6030  PRINT TAB(10) "A=ADD TO OR START FILE":PRINT:PRINT TAB(10) "R=READ, REVISE, OR PRINT FILE":PRINT:PRINT TAB(10) "F=ALPHABETIZE FILE":PRINT:PRINT TAB(10) "O=RETURN TO OPTIONS":PRINT:PRINT TAB(10) "M=RETURN TO MENU":SKIP=0
  149. 6040  X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="A" THEN 6060 ELSE IF X$="R" THEN 6200 ELSE IF X$="F" THEN 50000 ELSE IF X$="O" THEN CLS:GOTO 10 ELSE IF X$="M" THEN RUN "BKPG.BAS" ELSE 6040
  150. 6060  N=LOF(2)/128
  151. 6062  IF CAT THEN GOSUB 7040:GOTO 6062
  152. 6065  GOSUB 6070:GOTO 6065
  153. 6070  N=N+1
  154. 6080  PRINT " 3 LETTER ABBREVIATION FOR PAYEE (IF FINISHED ENTER F) ";:INLN%=3:GOSUB 20050:ABB$=INPT$:IF ABB$="F" THEN 6030
  155. 6095  IF LEN(ABB$)<>3 THEN COLOR 0,7:PRINT "  ABBREVIATION MUST BE 3 LETTERS--REENTER  ":COLOR 7,0:GOTO 6080
  156. 6100  PRINT "PAYEE ";:INLN%=35:GOSUB 20050:PAY$=INPT$:PRINT "STREET ADDRESS OR BOX NO. ";:INLN%=35:GOSUB 20050:ADR$=INPT$:PRINT "CITY, STATE  ZIP ";:INLN%=35:GOSUB 20050:CITY$=INPT$:PRINT "TYPE OF EXPENSE ";:INLN%=16:GOSUB 20050:EP$=INPT$:LSET F$=ABB$
  157. 6150  LSET G$=PAY$:LSET H$=ADR$:LSET I$=CITY$:LSET J$=EP$:PUT 2, N:RETURN
  158. 6200  CLS:PRINT:PRINT TAB(10) "R=READ ONLY":PRINT:PRINT TAB(10) "P=READ AND PRINT"
  159. 6220  PRT$=INKEY$:IF PRT$="P" OR PRT$="R" THEN CLS:GOTO 6230 ELSE 6220
  160. 6230  COLOR 0,7: PRINT "     PRESS   F8   TO READ RECORDS IN SEQUENCE.":PRINT"PRESS AGAIN TO CONTINUE READING AFTER EACH STOP.":PRINT"      PRESS ESCAPE TO RETURN TO OPTIONS.":COLOR 7,0: PRINT:PRINT
  161. 6240  COLOR 0,7:PRINT " IF REVISING FILE, WRITE DOWN RECORD NUMBERS TO BE CHANGED. IF THERE IS A RECORD NO LONGER USED, IT CAN BE REPLACED BY USING ITS RECORD NUMBER FOR A NEW ENTRY": PRINT:PRINT
  162. 6250  X$=INKEY$:IF X$<>"@" THEN 6250 ELSE COLOR 7,0:DEF SEG:POKE 106,0
  163. 6265  IF PRT$="P" THEN LPRINT CHR$(15)+CHR$(27)CHR$(78)CHR$(6):WIDTH "LPT1:", 132
  164. 6266  IF PRT$="P" AND CAT=1 THEN LPRINT CHR$(27)CHR$(45)CHR$(1):LPRINT TAB(40) "CATEGORY OF EXPENSE FILE  "+DATE$:LPRINT CHR$(27)CHR$(45)CHR$(0)
  165. 6267  IF PRT$="P" AND CAT=0 THEN LPRINT CHR$(27)CHR$(45)CHR$(1):LPRINT TAB(50) "PAYEE FILE  "+DATE$:LPRINT CHR$(27)CHR$(45)CHR$(0)
  166. 6270  FOR N=1 TO LOF(2)/128:GET 2, N:IF CAT THEN 7140
  167. 6330  PRINT "ABBREVIATION   "+F$+"    "+"REC.NO.";:PRINT N:PRINT G$:PRINT H$:PRINT I$:PRINT J$:PRINT:IF PRT$<>"P" THEN 6405
  168. 6390  LPRINT "REC.NO.   ";:LPRINT N:LPRINT F$+"  "+G$+"  "+H$+"  "+I$+"  "+J$
  169. 6405  IF N MOD 3=0 THEN 6407 ELSE 6410
  170. 6407  RX$=INKEY$:IF RX$=CHR$(27) THEN CLS:GOTO 6020 ELSE IF RX$<>"@" THEN 6407
  171. 6410  NEXT:IF PRT$="P" THEN LPRINT CHR$(27)CHR$(64)+CHR$(12)
  172. 6420  PRINT TAB(10) "R=REVISE FILE": PRINT TAB(10) "O=RETURN TO OPTIONS FOR THIS FILE"
  173. 6430  X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="R" THEN 6450 ELSE IF X$="O" THEN CLS:PRINT:PRINT:GOTO 6025 ELSE 6430
  174. 6450  PRINT "RECORD NUMBER TO BE CHANGED OR REPLACED ";:NBR=1:GOSUB 20050:N=VAL(INPT$):NBR=0:IF CAT THEN CLS:GOSUB 7050 ELSE GOSUB 6080
  175. 6470  PRINT:PRINT "REVISE ANOTHER? Y OR N";
  176. 6475  X$=INKEY$:DEF SEG=64:POKE 23, (PEEK(23) OR 64):IF X$="Y" THEN 6450 ELSE IF X$="N" THEN CLS:PRINT:PRINT:GOTO 6025 ELSE 6475 EDIT 7005
  177. 7000  CLS:CAT=1:OPEN "A:CATEGORY.FIL" AS 2:FIELD 2, 44 AS L$:GOTO 6025
  178. 7040  N=N+1:IF SKIP THEN 7090
  179. 7045  IF LOF(2)/128>27 THEN PRINT "NO MORE CATEGORIES MAY BE ADDED":GOTO 6030
  180. 7050  CLS:PRINT "1. THERE IS A LIMIT OF 28 CATEGORIES.":PRINT "2. THE FIRST 3 LETTERS OF A CATEGORY MAY NOT BE THE SAME AS THE FIRST 3 LETTERS    OF ANY OTHER."
  181. 7060  PRINT "3. EACH CATEGORY MAY BE SINGLE OR MADE UP OF UP TO 4 TYPES OF EXPENSE.  THESE      TYPES WILL BE COMPILED BY THE EXPENSE PROGRAM UNDER THIS CATEGORY.
  182. 7070  PRINT "4. IF THERE IS MORE THAN 1 TYPE OF EXPENSE IN A CATEGORY THEN:"TAB(5)" THERE MUST BE A COMMA AND A SPACE BETWEEN TYPES OF EXPENSE."
  183. 7080  PRINT:PRINT TAB(8) "EXAMPLE    "+CHR$(34)+"DUES, LICENSES, EDUCATION"
  184. 7090  LOCATE 13,1:FOR I=1 TO 80:PRINT CHR$(42);:NEXT:DEF SEG=64:POKE 23, (PEEK(23) OR 64):PRINT "REC.NO.  ";:PRINT N:PRINT "CATEGORY OF EXPENSE (IF FINISHED, ENTER F) ";:INLN%=44:GOSUB 20050:CAT$=INPT$:IF CAT$="F" THEN CLS:GOTO 6030
  185. 7120  LSET L$=CAT$:PUT 2, N:LOCATE 14,1:FOR I=1 TO 81:PRINT CHR$(32);:NEXT:SKIP=1:RETURN
  186. 7140  PRINT "REC.NO.   ";:PRINT N;:PRINT "   "+L$:PRINT:IF PRT$="P" THEN LPRINT "REC.NO.   ";:LPRINT N;:LPRINT "   "+L$:LPRINT
  187. 7160  GOTO 6410
  188. 9000  KEY(7) OFF:X$=INKEY$:IF X$=CHR$(27) THEN 10
  189. 9010  IF X$<>"@" THEN 9000 ELSE DEF SEG:POKE 106,0:KEY(7) ON:RETURN
  190. 10000  CLS:IF ERR=71 THEN COLOR 0,7:PRINT "     FILE DISK NOT IN DRIVE B OR PROGRAM DISK NOT IN DRIVE A OR DOOR IS OPEN.":PRINT:PRINT"     CORRECT PROBLEM AND PRESS F8 WHEN READY. ":GOTO 10050
  191. 10010  IF ERR=24 OR ERR=27 THEN COLOR 0,7:PRINT "     PRINTER NOT ON OR OUT OF PAPER.  SET TOP OF PAGE AND TURN ON PRINTER.           PRESS F8 WHEN READY.    ":GOTO 10050
  192. 10020  IF ERR=210 THEN DEF SEG=64:POKE 23, (PEEK(23) OR 64):RESUME
  193. 10030  IF ERR=53 THEN COLOR 0,7:PRINT "     FILE NOT FOUND ":PRINT:PRINT "     INSERT DISK CONTAINING FILE AND PRESS F8 WHEN READY .":GOTO 10050
  194. 10040  COLOR 0,7:PRINT "AN UNIDENTIFIED ERROR HAS OCCURRED":PRINT:PRINT "PRESS  F8  TO RETURN TO OPTIONS":COLOR 7,0
  195. 10045  X$=INKEY$:IF X$<>"@" THEN 10045 ELSE 10
  196. 10050  X$=INKEY$:IF X$<>"@" THEN 10050 ELSE COLOR 7,0:CLS:DEF SEG:POKE 106,0:RESUME
  197. 20050  INPT$="":INPOS%=POS(0):DEF SEG=64:POKE 23, (PEEK(23) OR 64):POKE 23, (PEEK(23) OR 32):LOCATE,,1,6,7:IF INLN%=0 THEN INLN%=10
  198. 20110  IP$=INKEY$:IF IP$="" THEN 20110
  199. 20130  IF NBR THEN IF ASC(IP$)>57 THEN BEEP:GOTO 20110
  200. 20140  IF NBR THEN IF ASC(IP$)<48 AND ASC(IP$)<>46 THEN IF ASC(IP$)<>8 AND ASC(IP$)<>13 THEN IF ASC(IP$)<>45 THEN BEEP:GOTO 20110
  201. 20150  IF ASC(IP$)=29 THEN BEEP:GOTO 20110
  202. 20155  IF ASC(IP$)=27 THEN 10
  203. 20160  IP$=CHR$(ASC(IP$)+32*(IP$>="a" AND IP$<="z")):IF LEN(INPT$)=INLN% THEN IF ASC(IP$)<>13 AND ASC(IP$)<>8 THEN 20110
  204. 20180  IF ASC(IP$)=13 THEN PRINT:GOTO 20240
  205. 20190  IF ASC(IP$)=8 AND POS(0)=INPOS% THEN 20110
  206. 20200  IF ASC(IP$)=8 THEN GOSUB 20250:GOTO 20110
  207. 20210  INPT$=INPT$+IP$:PRINT IP$;:GOTO 20110
  208. 20240  INLN%=0:RETURN
  209. 20250  IF INPT$="" THEN 20110
  210. 20260  INPT$=LEFT$(INPT$,LEN(INPT$)-1):LOCATE CSRLIN,POS(0)-1:PRINT " ";:LOCATE CSRLIN,POS(0)-1:RETURN
  211. 30210  IF BKUP THEN 30220 ELSE OPEN "B:BACKUP.FIL" AS 4:BKUP=1
  212. 30220  FIELD 4, 14 AS A$:IF LOF(4)/128=0 THEN 30280
  213. 30240  FOR N=1 TO LOF(4)/128:GET 4,N:IF FL$+STRING$(14-LEN(FL$),32)=A$ THEN 30300
  214. 30270  NEXT
  215. 30280  LSET A$=FL$:PUT 4, LOF(4)/128+1
  216. 30300  RETURN
  217. 50000  CLS
  218. 50005  IF NDIM=0 THEN COUNT%=LOF(2)/128:DIM DIRLST$(COUNT%):NDIM=1
  219. 50010  GOTO 60000
  220. 50020  IF SHELLD%=1 THEN 50070
  221. 50030  DEF SEG=LD.ADDR:BLOAD "SHELLSRT",0:SHELLSRT=0:SHELLD%=1
  222. 50070  SEQ$="A":FIELD 2, 126 AS AA$
  223. 50120  FOR N=1 TO COUNT%:GET 2,N:DIRLST$(N-1)=AA$:NEXT:DEF SEG=LD.ADDR:CALL SHELLSRT(SEQ$,COUNT%,DIRLST$(0)):FOR N=0 TO COUNT%-1:PRINT DIRLST$(N):LSET AA$=DIRLST$(N):PUT 2, N+1:NEXT:PRINT:PRINT TAB(10) "PRESS  F8  TO RETURN TO OPTIONS"
  224. 50240  MU$=INKEY$:IF MU$<>"@" THEN 50240 ELSE CLS:GOTO 10
  225. 60000  TRUE%=-1:FALSE%=0:LDOUT%=FALSE%:GOSUB 60180:GOSUB 60230:GOSUB 60270:IF NOT LDOUT% THEN 60130
  226. 60030  GOSUB 60340:GOTO 60160
  227. 60050  '
  228. 60130  GOSUB 60380:CLEAR ,CLR.ADDR:GOSUB 60180:GOSUB 60430
  229. 60160  GOTO 50020
  230. 60170  END
  231. 60180  SUBR.SIZE=400:RETURN
  232. 60230  DEF SEG=0:SYS.MEMORY=PEEK(&H413)+PEEK(&H414)*256:RETURN
  233. 60270  DEF SEG=0:BASIC.DS=(PEEK(&H510)+PEEK(&H511)*256):OUTSIDE.BASIC.DS=BASIC.DS+4104+(SUBR.SIZE/16):IF OUTSIDE.BASIC.DS*16<SYS.MEMORY*1024 THEN LDOUT%=TRUE%
  234. 60330  RETURN
  235. 60340  LD.ADDR=OUTSIDE.BASIC.DS-(SUBR.SIZE/16):RETURN
  236. 60380  DEF SEG:TOP.STACK=PEEK(&H2C)+PEEK(&H2D)*256:CLR.ADDR=(TOP.STACK-SUBR.SIZE)-128:RETURN
  237. 60430  DEF SEG=0:BASIC.DS=16*(PEEK(&H510)+PEEK(&H511)*256):DEF SEG:TOP.STACK=PEEK(&H2C)+PEEK(&H2D)*256:LD.ADDR=(BASIC.DS+TOP.STACK)/16:LD.ADDR=INT(LD.ADDR+0.5):RETURN
  238.